home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / S-Sound and Music / (c)s3.d64 / retuner.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  2KB  |  73 lines
  1. 1 REM *** TUNER & NOTE TABLE ***
  2. 2 REM *** THIS PROGRAM GIVES THE HIGH
  3. 3 REM *** & LOW POKES FOR THE CHROMA-
  4. 4 REM *** TIC SCALE IF YOU WANT TO TUNE
  5. 5 REM *** YOUR C-64 HIGHER OR LOWER
  6. 6 REM *** THAN YOUR MANUAL SUGGESTS.
  7. 7 REM *** COPYRIGHT JOHN BATCHELOR
  8. 8 REM *** TRELAWNY SOFTWARE
  9. 9 REM *** NOT FOR SALE
  10. 15 POKE53281,15:POKE53280,6:POKE646,0
  11. 20 SB=54272
  12. 25 H=28:L=214
  13. 30 POKESB+5,96:POKESB+6,240:POKESB+24,15
  14. 39 PRINTCHR$(14)
  15. 40 PRINT"[147][212]UNING NOTE IS [193]."
  16. 50 PRINT"[208]RESS [211][146] TO HEAR NOTE."
  17. 60 PRINT"[208]RESS [210][146] TO RAISE NOTE."
  18. 70 PRINT"[208]RESS [204][146] TO LOWER NOTE."
  19. 80 PRINT"[208]RESS [212][146] FOR NOTE TABLE ON SCREEN."
  20. 90 PRINT"[208]RESS [208][146] FOR NOTE TABLE ON PRINTER."
  21. 100 PRINT"[208]RESS [209][146] TO QUIT."
  22. 110 POKE198,0:KY=PEEK(203)
  23. 115 IFKY=62THENPRINT"[147]":END:END
  24. 120 IFKY=13THEN200
  25. 125 IFKY=17THEN300
  26. 130 IFKY=42THEN400
  27. 135 IFKY=22THEN500
  28. 140 IFKY=41THEN600
  29. 150 GOTO110
  30. 200 REM***PLAY NOTE UNTIL S IS RELEASED
  31. 210 POKESB+1,H:POKESB,L
  32. 220 POKESB+4,17
  33. 230 IFPEEK(203)<>13THENPOKESB+4,16:GOTO110
  34. 240 GOTO230
  35. 300 REM***RAISE NOTE
  36. 310 L=L+1
  37. 320 IFL>=256THENL=0:H=H+1:IFH>255THENH=0
  38. 330 POKESB+1,H:POKESB,L
  39. 340 POKESB+4,17
  40. 350 IFPEEK(203)<>17THENPOKESB+4,16:GOTO110
  41. 360 GOTO310
  42. 400 REM***LOWER NOTE
  43. 410 L=L-1
  44. 420 IFL<=0THENL=255:H=H-1:IFH<0THENH=255
  45. 430 POKESB+1,H:POKESB,L
  46. 440 POKESB+4,17
  47. 450 IFPEEK(203)<>42THENPOKESB+4,16:GOTO110
  48. 460 GOTO410
  49. 500 REM***NOTE TABLE ON SCREEN
  50. 501 P=0
  51. 505 PRINT"[147]";CHR$(142)
  52. 508 XX=2^(1/12)
  53. 510 S$="#":LL$="AABCCDDEFFGGAABCCDDEFFGGAABCCDDEFFGGAABC"
  54. 515 AF=(256*H+L)/4 :LS$="0100101001010100101001010100101001010100"
  55. 520 PRINT"STARTS AT A IN BASS CLEF"
  56. 530 PRINT"GOES TO C ABOVE TREBLE CLEF"
  57. 535 FORJ=1TO20
  58. 540 CF=AF*XX^(J*2-2):C2=CF*XX
  59. 545 CA=INT(CF/256):CB=INT(CF-CA*256+.5):CC=INT(C2/256):CD=INT(C2-CC*256+.5)
  60. 550 D1$=MID$(LL$,J*2-1,1):D2$=" ":IFMID$(LS$,J*2-1,1)="1"THEND2$=S$
  61. 560 D3$=MID$(LL$,J*2,1):D4$=" ":IFMID$(LS$,J*2,1)="1"THEND4$=S$
  62. 570 PRINTD1$;D2$;CA;CB;TAB(20);D3$;D4$;CC;CD
  63. 580 NEXTJ
  64. 585 POKE198,0
  65. 586 IFP=1THENPRINT#4:CLOSE4
  66. 590 PRINT"PRESS ANY KEY TO RE-DO"
  67. 595 GETQ$:IFQ$=""THEN595
  68. 596 GOTO39
  69. 600 REM***NOTE TABLE ON PRINTER
  70. 610 P=1
  71. 620 OPEN4,4:CMD4
  72. 630 GOTO508
  73.